home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-utl.el.z / ilisp-utl.el
Encoding:
Text File  |  1998-05-21  |  3.8 KB  |  130 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-utl.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23.  
  24.  
  25. ;;;
  26. ;;; ILISP misc tools.
  27. ;;;
  28.  
  29. (defun lisp-show-send (string)
  30.   "Show STRING in the *ilisp-send* buffer."
  31.   (save-excursion
  32.     (if (ilisp-buffer)
  33.     (set-buffer "*ilisp-send*")
  34.     (error "You must start an inferior LISP with run-ilisp."))
  35.     (erase-buffer)
  36.     (insert string)
  37.     string))
  38.  
  39.  
  40. ;;;
  41. (defun lisp-slashify (string)
  42.   "Put string in the *ilisp-send* buffer, put backslashes before
  43. quotes and backslashes and return the resulting string."
  44.   (save-excursion
  45.     (lisp-show-send string)
  46.     (set-buffer "*ilisp-send*")
  47.     (goto-char (point-min))
  48.     (while (search-forward "\\" nil t)
  49.       (delete-char -1)
  50.       (insert "\\\\"))
  51.     (goto-char (point-min))
  52.     (while (search-forward "\"" nil t)
  53.       (backward-char)
  54.       (insert ?\\)
  55.       (forward-char))
  56.     (buffer-substring (point-min) (point-max))))
  57.  
  58.  
  59. ;;;%%String
  60. (defun lisp-prefix-p (s1 s2)
  61.   "Returns t if S1 is a prefix of S2 considering all non alphanumerics
  62. as word delimiters."
  63.   (let ((len1 (length s1)))
  64.     (and (<= len1 (length s2))
  65.      (let ((start 0)
  66.            (start2 0) 
  67.            end
  68.            (match t))
  69.        (while
  70.            (if (setq end (string-match "[^a-zA-Z0-9]" s1 start))
  71.            ;; Found delimiter
  72.            (if (string= (substring s1 start end)
  73.             (substring s2 start2 (+ start2 (- end start))))
  74.                ;; Words are the same
  75.                (progn (setq start (match-end 0))
  76.                   (if (string-match
  77.                    (regexp-quote (substring s1 end start))
  78.                    s2 start2)
  79.                   (setq start2 (match-end 0)) ;OK
  80.                 (setq match nil))) ;Can't find delimiter
  81.              (setq match nil))    ;Words don't match 
  82.          nil))            ;Ran out of delimiters in s1
  83.        (and match
  84.         (string= (substring s1 start len1)
  85.          (substring s2 start2 (+ start2 (- len1 start)))))))))
  86.  
  87.  
  88. ;;;
  89. (defun lisp-last-line (string)
  90.   "Return the last line of STRING with everything else."
  91.   (let* ((position 0))
  92.     (while (string-match "\\(\n+\\)[^\n]" string position)
  93.       (setq position (match-end 1)))
  94.     (cons (substring string position)
  95.       (substring string 0 position))))
  96.  
  97.  
  98. ;;;%%File
  99. ;;;
  100. (defun lisp-file-extension (file extension)
  101.   "Return FILE with new EXTENSION."
  102.   (concat (substring file 0 (string-match ".[^.]*$" file))
  103.       "." extension))
  104.  
  105. (defun ilisp-directory (file &optional dirs)
  106.   "Return the directory of DIRS that FILE is found in.  By default
  107. load-path is used for the directories."
  108.   (let* ((dirs (or dirs (cons "" load-path)))
  109.      (dir (car dirs)))
  110.     (while (and dir (not (file-exists-p (expand-file-name file dir))))
  111.       (setq dirs (cdr dirs)
  112.         dir (car dirs)))
  113.     dir))
  114.  
  115.  
  116. ;;; ilisp-update-status --
  117. ;;;
  118. ;;; Note: changed in order to propagate the status change in the
  119. ;;;       underlying process to the menu.
  120.  
  121. (defun ilisp-update-status (status)
  122.   "Update process STATUS of the whole Ilisp system.
  123. It updates the STATUS of the current buffer and let all lisp mode
  124. buffers know as well.  Also, do some 'exterior' things like make sure
  125. that the menubar is in a consistent state."
  126.   (setq ilisp-status (if lisp-show-status (format " :%s" status)))
  127.   (if (not (member +ilisp-emacs-version-id+ '(xemacs lucid-19 lucid-19-new)))
  128.       (ilisp-update-menu status))
  129.   (comint-update-status status))
  130.